home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 7 / Apprentice-Release7.iso / Source Code / C / Applications / Moscow ML 1.42 / src / mosmllib / StringCvt.sml < prev    next >
Encoding:
Text File  |  1997-08-18  |  2.8 KB  |  105 lines  |  [TEXT/R*ch]
  1. (* StringCvt -- new basis 1995-04-06, 1995-10-26, 1996-04-01, 1997-06-03 *)
  2.  
  3. local
  4.     prim_val sub_      : string -> int -> char  = 2 "get_nth_char";
  5.     prim_val mkstring_ : int -> string          = 1 "create_string";
  6.     prim_val fill_     : string -> int -> int -> char -> unit 
  7.                                                 = 4 "fill_string";
  8.     prim_val blit_     : string -> int -> string -> int -> int -> unit 
  9.                                                 = 5 "blit_string";
  10.     prim_val set_nth_  : string -> int -> char -> unit 
  11.                                                 = 3 "set_nth_char";
  12.  
  13.     fun sub_string_ s start len =
  14.     let val res = mkstring_ len
  15.     in blit_ s start res 0 len; res end
  16.  
  17. in
  18.  
  19. datatype radix = BIN | OCT | DEC | HEX;
  20. datatype realfmt = 
  21.     SCI of int option    (* scientific,  arg = # dec. digits, dflt=6 *)
  22.   | FIX of int option   (* fixed-point, arg = # dec. digits, dflt=6 *)
  23.   | GEN of int option     (* auto choice of the above,                *)
  24.                         (* arg = # significant digits, dflt=12      *)
  25.  
  26. type cs = int        (* the state of a string character source   *)
  27.  
  28. type ('a, 'b) reader = 'b -> ('a * 'b) option
  29.  
  30. fun scanString scan s =
  31.     let val len = size s
  32.     fun getc i = if i >= len then NONE 
  33.              else SOME (sub_ s i, i+1)
  34.     in case scan getc 0 of
  35.     NONE          => NONE
  36.       | SOME (res, _) => SOME res
  37.     end;
  38.  
  39. fun dropl p getc = 
  40.     let fun h src =
  41.     case getc src of
  42.         NONE          => src
  43.       | SOME(c, rest) => if p c then h rest else src
  44.     in h end;
  45.  
  46. (* skipWS getc = dropl Char.isSpace getc; here specialized for efficiency: *)
  47. fun skipWS getc = 
  48.     let fun h src =
  49.     case getc src of
  50.         NONE          => src
  51.       | SOME(c, rest) => 
  52.         if c = #" " orelse #"\009" <= c andalso c <= #"\013" 
  53.             then h rest 
  54.         else src
  55.     in h end;
  56.  
  57. fun splitl p getc =
  58.     let val max = ref 15
  59.     val tmp = ref (mkstring_ (!max))
  60.     fun realloc () =
  61.         let val newmax = 2 * !max
  62.         val newtmp = mkstring_ newmax
  63.         in 
  64.         blit_ (!tmp) 0 newtmp 0 (!max);
  65.         max := newmax;
  66.         tmp := newtmp
  67.         end
  68.     fun h len src =
  69.         case getc src of
  70.         NONE          => (sub_string_ (!tmp) 0 len, src)
  71.           | SOME(c, rest) => 
  72.             if p c then 
  73.             (if len >= !max then realloc () else ();
  74.              set_nth_ (!tmp) len c;
  75.              h (len+1) rest)
  76.             else
  77.             (sub_string_ (!tmp) 0 len, src)
  78.     in h 0 end;
  79.  
  80. fun takel p getc src = #1 (splitl p getc src);
  81.  
  82. fun padLeft c n s = 
  83.     let val ssize = size s
  84.     in if n <= ssize then s
  85.        else let val res = mkstring_ n 
  86.         in
  87.         fill_ res 0 (n - ssize) c;
  88.         blit_ s 0 res (n - ssize) ssize;
  89.         res
  90.         end
  91.     end;
  92.          
  93. fun padRight c n s = 
  94.     let val ssize = size s
  95.     in if n <= ssize then s
  96.        else let val res = mkstring_ n 
  97.         in
  98.         blit_ s 0 res 0 ssize;
  99.         fill_ res ssize (n - ssize) c;
  100.         res
  101.         end
  102.     end;
  103.  
  104. end
  105.